#!/usr/bin/perl -w
# I modified this lwp-download script to a function: lwp-download(uri, directory/file_name);
package lwpdownload;

use LWP::UserAgent ();
use LWP::MediaTypes qw(guess_media_type media_suffix);
use URI ();
use HTTP::Date ();


sub download{
    my %opt;
    $opt{a} = 0;
    $opt{s} = 1;
    my $progname = $0;
    $progname =~ s,.*/,,;    # only basename left in progname
    $progname =~ s,.*\\,, if $^O eq "MSWin32";
    $progname =~ s/\.\w*$//; # strip extension if any
    
    my $url = URI->new(shift || usage());
    my $argfile = shift;
    usage() if defined($argfile) && !length($argfile);
    my $VERSION = "5.835";
    
    my $ua = LWP::UserAgent->new(
	agent => "lwp-download/$VERSION ",
	keep_alive => 1,
	env_proxy => 1,
	);

    my $file;      # name of file we download into
    my $length;    # total number of bytes to download
    my $flength;   # formatted length
    my $size = 0;  # number of bytes received
    my $start_t;   # start time of download
    my $last_dur;  # time of last callback
    
    my $shown = 0; # have we called the show() function yet
    
    $SIG{INT} = sub { die "Interrupted\n"; };
    
    $| = 1;  # autoflush
    
    my $res = $ua->request(HTTP::Request->new(GET => $url),
			   sub {
			       unless(defined $file) {
				   my $res = $_[1];
				   
				   my $directory;
				   if (defined $argfile && -d $argfile) {
				       ($directory, $argfile) = ($argfile, undef);
				   }
				   
				   unless (defined $argfile) {
				       # find a suitable name to use
				       $file = $opt{s} && $res->filename;
				       
				       # if this fails we try to make something from the URL
				       unless ($file) {
					   $file = ($url->path_segments)[-1];
					   if (!defined($file) || !length($file)) {
					       $file = "index";
					       my $suffix = media_suffix($res->content_type);
					       $file .= ".$suffix" if $suffix;
					   }
					   elsif ($url->scheme eq 'ftp' ||
						  $file =~ /\.t[bg]z$/   ||
						  $file =~ /\.tar(\.(Z|gz|bz2?))?$/
					       ) {
					       # leave the filename as it was
					   }
					   else {
					       my $ct = guess_media_type($file);
					       unless ($ct eq $res->content_type) {
						   # need a better suffix for this type
						   my $suffix = media_suffix($res->content_type);
						   $file .= ".$suffix" if $suffix;
					       }
					   }
				       }
				       
				       # validate that we don't have a harmful filename now.  The server
				       # might try to trick us into doing something bad.
				       if (!length($file) ||
					   $file =~ s/([^a-zA-Z0-9_\.\-\+\~])/sprintf "\\x%02x", ord($1)/ge ||
					   $file =~ /^\./
					   )
				       {
					   die "Will not save <$url> as \"$file\".\nPlease override file name on the command line.\n";
				       }
				       
				       if (defined $directory) {
					   require File::Spec;
					   $file = File::Spec->catfile($directory, $file);
				       }
				       
				       # Check if the file is already present
				       if (-l $file) {
					   die "Will not save <$url> to link \"$file\".\nPlease override file name on the command line.\n";
				       }
				       elsif (-f _) {
					   die "Will not save <$url> as \"$file\" without verification.\nEither run from terminal or override file name on the command line.\n"
					       unless -t;
					   $shown = 1;
					   print "Overwrite $file? [y] ";
					   my $ans = <STDIN>;
					   unless (defined($ans) && $ans =~ /^y?\n/) {
					       if (defined $ans) {
						   print "Ok, aborting.\n";
					       }
					       else {
						   print "\nAborting.\n";
					       }
					       1;
					   }
					   $shown = 0;
				       }
				       elsif (-e _) {
					   die "Will not save <$url> as \"$file\".  Path exists.\n";
				       }
				       else {
					   print "Saving to '$file'...\n";
					   use Fcntl qw(O_WRONLY O_EXCL O_CREAT);
					   sysopen(FILE, $file, O_WRONLY|O_EXCL|O_CREAT) ||
					       die "Can't open $file: $!";
				       }
				   }
				   else {
				       $file = $argfile;
				   }
				   unless (fileno(FILE)) {
				       open(FILE, ">", $file) || die "Can't open $file: $!\n";
				   }
				   binmode FILE unless $opt{a};
				   $length = $res->content_length;
				   $flength = fbytes($length) if defined $length;
				   $start_t = time;
				   $last_dur = 0;
			       }
			       
			       print FILE $_[0] or die "Can't write to $file: $!\n";
			       $size += length($_[0]);
			       
			       if (defined $length) {
				   my $dur  = time - $start_t;
				   if ($dur != $last_dur) {  # don't update too often
				       $last_dur = $dur;
				       my $perc = $size / $length;
				       my $speed;
				       $speed = fbytes($size/$dur) . "/sec" if $dur > 3;
				       my $secs_left = fduration($dur/$perc - $dur);
				       $perc = int($perc*100);
				       my $show = "$perc% of $flength";
				       $show .= " (at $speed, $secs_left remaining)" if $speed;
				       show($show, 1);
				   }
			       }
			       else {
				   show( fbytes($size) . " received");
			       }
			   }
	);
    
    if (fileno(FILE)) {
	close(FILE) || die "Can't write to $file: $!\n";
	
	show("");  # clear text
	print "\r";
	print fbytes($size);
	print " of ", fbytes($length) if defined($length) && $length != $size;
	print " received";
	my $dur = time - $start_t;
	if ($dur) {
	    my $speed = fbytes($size/$dur) . "/sec";
	    print " in ", fduration($dur), " ($speed)";
	}
	print "\n";
	
	if (my $mtime = $res->last_modified) {
	    utime time, $mtime, $file;
	}
	
	if ($res->header("X-Died") || !$res->is_success) {
	    if (my $died = $res->header("X-Died")) {
		print "$died\n";
	    }
	    if (-t) {
		print "Transfer aborted.  Delete $file? [n] ";
		my $ans = <STDIN>;
		if (defined($ans) && $ans =~ /^y\n/) {
		    unlink($file) && print "Deleted.\n";
		}
		elsif ($length > $size) {
		    print "Truncated file kept: ", fbytes($length - $size), " missing\n";
		}
		else {
		    print "File kept.\n";
		}
		1;
	    }
	    else {
		print "Transfer aborted, $file kept\n";
	    }
	}
    }
    
# Did not manage to create any file
    print "\n" if $shown;
    if (my $xdied = $res->header("X-Died")) {
	print "$progname: Aborted\n$xdied\n";
    }
    else {
#	print "$progname: ", $res->status_line, "\n";
    }

    if($res->is_success){
	return 0;
    }
    1;
}

sub fbytes
{
    my $n = int(shift);
    if ($n >= 1024 * 1024) {
	return sprintf "%.3g MB", $n / (1024.0 * 1024);
    }
    elsif ($n >= 1024) {
	return sprintf "%.3g KB", $n / 1024.0;
    }
    else {
	return "$n bytes";
    }
}

sub fduration
{
    use integer;
    my $secs = int(shift);
    my $hours = $secs / (60*60);
    $secs -= $hours * 60*60;
    my $mins = $secs / 60;
    $secs %= 60;
    if ($hours) {
	return "$hours hours $mins minutes";
    }
    elsif ($mins >= 2) {
	return "$mins minutes";
    }
    else {
	$secs += $mins * 60;
	return "$secs seconds";
    }
}


BEGIN {
    my @ani = qw(- \ | /);
    my $ani = 0;

    sub show
    {
        my($mess, $show_ani) = @_;
        print "\r$mess" . (" " x (75 - length $mess));
	print $show_ani ? "$ani[$ani++]\b" : " ";
        $ani %= @ani;
        $shown++;
    }
}

sub usage
{
    die "Usage: $progname [-a] <url> [<lpath>]\n";
}

1;
